home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-13 / fco_me.zip / ME.PRG < prev   
Text File  |  1993-03-14  |  8KB  |  329 lines
  1. *******************************************************************************
  2. *
  3. *  ME - MiniEditor / 2.3.92
  4. *
  5. *******************************************************************************
  6. *  Release 1.01 / 31.07.92
  7. *
  8.  
  9. #include data.hdr
  10. #include colors.hdr
  11. #include io.hdr
  12. #include database.hdr
  13. #include fileio.hdr
  14. #include string.hdr
  15. #include system.hdr
  16. #include keys.hdr
  17. #include error.hdr
  18. #include warn.hdr
  19. #include math.hdr
  20. #include memo.hdr
  21. #include date.hdr
  22. #include tsr.hdr
  23.  
  24. *******************************************************************************
  25. *
  26. *  Defines
  27. *
  28. *******************************************************************************
  29.  
  30. #define vers    "1.01"
  31.  
  32.  
  33. *******************************************************************************
  34. *
  35. *  Database strukture
  36. *
  37. *******************************************************************************
  38.  
  39. DBFDEF ME
  40.         MEMO    text
  41. ENDDEF
  42.  
  43.  
  44. *******************************************************************************
  45. *
  46. *  Global Variables
  47. *
  48. *******************************************************************************
  49.  
  50. VARDEF
  51.     CHAR(80)    temp_path
  52.     CHAR(80)    me_dbf
  53.     INT         msg_color = &green_black
  54.     INT         std_color = &blue_light_cyan
  55.     UINT        ax, bx, cx, dx, si, di, bp, ds, es
  56.     UINT        old_cursor
  57.     FILE        f
  58.     CHAR(128)   datei
  59.     CHAR(128)   dateiname
  60.     CHAR(255)   line
  61.     LOGICAL     insert
  62. ENDDEF
  63.  
  64.  
  65. *******************************************************************************
  66. *
  67. *  Allgemeine Funktionen
  68. *
  69. *******************************************************************************
  70.  
  71.  
  72. *--- Laufzeitfehler ausgeben und Programm korrekt beenden
  73. *
  74. PROCEDURE error_proc
  75.   set color to
  76.   ?
  77.   ?
  78.   ?? chr(7)
  79.   @10, 5 ?? "Laufzeitfehler:",trim(i_str(__errcode))+", "+e_message()
  80.   @11, 5 ?? "     Datenbank:",dbf()
  81.   @12, 5 ?? "        Record:",i_str(recno())
  82.   @13, 0
  83.   cursor_on
  84.   quit
  85. ENDPRO
  86.  
  87. *--- Shift Status anzeigen
  88. *
  89. PROCEDURE shift_status
  90.   PARAMETERS CONST logical x
  91.   VARDEF
  92.     INT r, c, oldcolor
  93.   ENDDEF
  94.   IF lastkey() = &K_INS .or. x
  95.     oldcolor = __color_std
  96.     r = row()
  97.     c = col()
  98.     __color_std = msg_color
  99.     ax = 0x0200
  100.     Interrupt(0x16, ax, bx, cx, dx, si, di, bp, ds, es)
  101.     IF bittest( ax,7 )
  102.       insert = .t.
  103.       @ 0,65 ?? "Einfg"
  104.       ax = 0x0100
  105.       cx = 0x010e
  106.       Interrupt(0x10, ax, bx, cx, dx, si, di, bp, ds, es)
  107.       ELSE
  108.         insert = .f.
  109.         @ 0,65 ?? space(5)
  110.         ax = 0x0100
  111.         cx = 0x0d0e
  112.         Interrupt(0x10, ax, bx, cx, dx, si, di, bp, ds, es)
  113.     ENDIF
  114.     __color_std = oldcolor
  115.     @ r, c
  116.   ENDIF
  117. ENDPRO
  118.  
  119. *--- Alles Eingaben gehen über diese Routine
  120. *
  121. FUNCTION UINT keyfilter
  122.   VARDEF
  123.     UINT col, row, n
  124.   ENDDEF
  125.   do shift_status with .f.
  126.   ax = 0x0300
  127.   Interrupt(0x10, ax, bx, cx, dx, si, di, bp, ds, es)
  128.   col = dx % 256
  129.   row = dx / 256
  130.  
  131.   @0,50 ?? row,col
  132.  
  133.   DO CASE
  134.     CASE lastkey() = &K_F1
  135.       save_screen()
  136.       IF exist( trim(temp_path)+"me.hlp" )
  137.         clear
  138.         type( trim(temp_path)+"me.hlp" )
  139.         DO WHILE inkey() = 0
  140.         ENDDO
  141.         ELSE
  142.           ?? chr(7)
  143.       ENDIF
  144.       restore_area()
  145.       RETURN &K_F1
  146.     CASE lastkey() = &K_TAB
  147.       IF insert
  148.         keyboard( space( 8-( col % 8)))
  149.         ELSE
  150.           n = 8-( col % 8 )
  151.           DO while n > 0
  152.             key_int( &K_RIGHT )
  153.             n = n - 1
  154.           ENDDO
  155.       ENDIF
  156.   ENDCASE
  157.   RETURN lastkey()
  158. ENDPRO
  159.  
  160.  
  161. *******************************************************************************
  162. *
  163. *    Function: FCO_MAIN
  164. * Description: Main entry point for program.
  165. *
  166. *
  167. *******************************************************************************
  168.  
  169. PROCEDURE FCO_main
  170.   PARAMETERS CONST char(128) cmd_line
  171.  
  172.   SET SCOREBOARD OFF
  173.   SET MESSAGE TO 24
  174.   SET INTENSITY ON
  175.   SET EXACT OFF
  176.   SET DATE GERMAN
  177.  
  178.   *--- MemoBuffer setzen
  179.   __memo_max = 32768
  180.  
  181.   *--- Hilfe mit F1, alle Eingaben über keyfilter
  182.   ON KEY DO keyfilter
  183.  
  184.   *---setup error procedure
  185.   ON ERROR DO error_proc
  186.  
  187.   *--- DOS benutzen
  188.   DO scrn_dos
  189.   DO key_dos
  190.  
  191.   *--- alte Cursorform sichern
  192.   ax = 0x0300
  193.   bx = 0x000
  194.   Interrupt(0x10, ax, bx, cx, dx, si, di, bp, ds, es)
  195.   old_cursor = cx
  196.  
  197.   *--- create path from current directory
  198.   temp_path = chr( curdrive() + 'A' ) + ":" +  curdir( 0 )
  199.   IF right( temp_path, 1 ) <> "\"
  200.     *--- add ending backslash
  201.     temp_path = temp_path + "\"
  202.   ENDIF
  203.   me_dbf = temp_path + "ME.DBF"
  204.  
  205.   *--- Farben setzen
  206.   IF .NOT. iscolor() .OR. "/mono" $ lower( cmd_line )
  207.     msg_color = &white_black
  208.     std_color = &black_white
  209.   ENDIF
  210.  
  211.   IF "/mono" $ lower( cmd_line )
  212.     datei = trim( stuff( cmd_line, at( "/mono", lower( cmd_line )), 5, "" ))
  213.     ELSE
  214.       datei = trim( cmd_line )
  215.   ENDIF
  216.  
  217.   DO CASE
  218.     case len( datei ) = 0
  219.       ? "MiniEditor v"+&vers+" (c) 1992 by Alfred Klich"
  220.       ? chr(7)+"Syntax: ME [Laufwerk:]Dateiname [/mono]"
  221.       delay(1)
  222.       quit
  223.     case filesize( datei ) > __memo_max
  224.       ? chr(7)+"Datei darf maximal",;
  225.                 trim( i_str( __memo_max )),"Byte groß sein"
  226.       delay(1)
  227.       quit
  228.   ENDCASE
  229.  
  230.   *--- Dateiname ohne Extension sichern
  231.   dateiname = left( datei, at( ".", datei ) -1 )
  232.       
  233.   *--- Datenbank neu erzeugen
  234.   IF exist( me_dbf )
  235.     erase "me.dbf"
  236.     erase "me.dbt"
  237.   ENDIF
  238.   BUILD me_dbf FROM ALIAS me
  239.   use me_dbf alias me
  240.   append blank
  241.  
  242.   __color_std = std_color
  243.   clear
  244.   __color_std = msg_color
  245.   @ 0, 0 clear to 0,79
  246.   @ 0, 1 ?? "ME v"+&vers,"(c) 1992 by Alfred Klich"
  247.   @ 0,40 ?? "["+datei+"]"
  248.   @24, 0 clear to 24,79
  249.   @24, 1 ?? "F1 = Hilfe · Ctrl-W = speichern + Ende · Esc = Abbruch"
  250.   __color_std = std_color
  251.  
  252.   *--- Status und Cursor anzeigen
  253.   DO shift_status with .t.
  254.  
  255.   *--- Wenn Datei vorhanden, Text in Memofeld laden
  256.   *
  257.   IF exist( datei )
  258.     f_open( f, datei, &F_READ )
  259.     m_open( me->text, &MO_CREATE )
  260.     f_getln( f, line )                  && 1. Zeile übergehen
  261.     m_put( me->text, line )
  262.     DO WHILE .not. f_eof( f )
  263.       f_getln( f, line )
  264.       *--- <tabs> durch <space> ersetzen
  265.       DO WHILE .T.
  266.         IF at( chr( 9 ), line ) > 0
  267.           line = stuff( line, at( chr( 9 ), line ), 1,;
  268.                         space( 9 - at( chr( 9 ), line ) % 8 ))
  269.           ELSE
  270.             exit
  271.         ENDIF
  272.       ENDDO
  273.       *--- unötige leerzeichen entfernrn
  274.       m_putln( me->text, rtrim( line ))
  275.     ENDDO
  276.     f_close( f )
  277.     m_close( me->text )
  278.     *--- .TMP-Datei erstellen
  279.     copy file ( datei ) to ( dateiname + ".TMP" )
  280.   ENDIF
  281.  
  282.   *--- Text im Memofeld editieren
  283.   *
  284.   m_edit( me->text, 1, 0,23,79,.F. )
  285.  
  286.   *--- Text wieder in Datei zurückschreiben
  287.   *
  288.   IF lastkey() <> &K_ESC
  289.     m_open( me->text, &MO_READ )
  290.     f_open( f, datei, &MO_CREATE )
  291.     m_getln( me->text, line )
  292.     f_put( f, line )
  293.     DO WHILE .not. m_eof( me->text )
  294.       m_getln( me->text, line )
  295.       f_putln( f, rtrim( line ))
  296.     ENDDO
  297.     m_close( me->text )
  298.     f_close( f )
  299.     *--- .TMP in .BAK-Datei umbenennen
  300.     IF exist( dateiname + ".BAK" ) 
  301.       erase( dateiname + ".BAK" )
  302.     ENDIF  
  303.     IF exist( dateiname + ".TMP" )
  304.       rename( dateiname + ".TMP" ) to ( dateiname + ".BAK" ) 
  305.     ENDIF
  306.     ELSE
  307.       *--- .TMP-Datei löschen
  308.       IF exist( dateiname + ".TMP" )
  309.         erase ( dateiname + ".TMP" )
  310.       ENDIF
  311.   ENDIF
  312.  
  313.   *--- alte Cursorform wieder herstellen
  314.   *
  315.   ax = 0x0100
  316.   cx = old_cursor
  317.   Interrupt(0x10, ax, bx, cx, dx, si, di, bp, ds, es)
  318.  
  319.   *--- Programm beenden
  320.   *
  321.   close all
  322.   set color to
  323.   clear
  324.   quit
  325.  
  326.   ! me list structure
  327.   
  328. ENDPRO
  329.